perm filename FILDIS.FAI[XX,LCS] blob
sn#267328 filedate 1977-02-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN FILLMS
C00014 ENDMK
C⊗;
BEGIN FILLMS
TITLE FILLMS
ENTRY FILLMS,DST,LL
EXTERNAL DL,PLTR,STF,ALF,LINES,UNPACK,RINP,.COMM.
DEFINE R9< .COMM.+=10>
DST: 0.005 ;BB
2.2 ;CC
LL: 0
;****** CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
; SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
; COMMON/DL/RSIZ,SAVER,NAME
; COMMON/DST/BB,CC/FLM/X(600)
; DIMENSION IDAT(1),NX(600)
; EQUIVALENCE (NX,X)
; COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
; MD=DISPLAY MP=PLOTTER MX=XGP
; DATA M2/2/
FILLMS: 0
MOVE PLTR+2 ;
MOVEM DX# ; DX=DIS
MOVE PLTR+1 ; RX=RHT
MOVEM RX#
MOVE @4(16) ; D=RSTJ2*R6
FMPR STF+10
MOVEM D#
MOVE @5(16) ; R=RSTJ2*R7
FMPR STF+10
MOVEM R#
DIST2: SKIPGE R9 ;DISTORT IF R9.GE.0
JRST FM1 ;GO TO 1
MOVE DST+1
MOVEM C# ; C=CC
MOVE DST ; B=BB
MOVEM B# ; SAVES IT. IT WILL RETURN LATER.
FDVR PLTR+2 ; BB=B/DIS
MOVEM DST
MOVE [1000.0] ; CC=1000
MOVEM DST+1
FM1: MOVNI 13,2 ;1 KK=-2
SETZ 7, ; KK IS 13, J IS 7 DO 205 J=1,L
MOVEI 12,@1(16) ;LOC OF IDAT
FM205: ADDI 13,3 ; KK=KK+3
; KX=KK+2
JSA 16,UNPACK ; CALL UNPACK(M,N,IDAT(J))
4 ;X COORD.
5 ;Y COORD.
(12) ; ; 12 IS IDAT ARRAY
AOJ 12, ; UPDATE POINTER
MOVEM 1,RINP+1(13) ; LL (=2 PEN DN., =3 PEN UP.)
FLTR 4 ; X(KK)=(R2+D*M)*DIS
FMPR D ;CC X(KK)=ROFF((R2+D*M)*DIS)
FADR @2(16)
FMPR PLTR+2
MOVEM RINP-1(13) ; X COORD.
FLTR 5 ;CC X(KK+1)=ROFF((CENTR+R*N)*RHT)
FMPR R ; X(KK+1)=(CENTR+R*N)*RHT
FADR @3(16)
FMPR PLTR+1
MOVEM RINP(13) ; Y COORD.
DIST3: SKIPGE R9
JRST FM3 ;3 GO TO 205
MOVM RINP-1(13)
FMPR DST ; X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
MOVNS ;C FOR DISTORTION
FADR C
FMPRM RINP(13)
FM3: AOJ 7, ;205 CONTINUE
CAME 7,@(16)
JRST FM205
ADDI 13,2 ; NX(3)=KX
MOVEM 13,RINP+2
MOVSI 201400
MOVEM PLTR+2 ; DIS=1.0
MOVEM PLTR+1 ; RHT=DIS
;; MOVEI 10,1 ; IF(IPLT)M=RSIZ+.4
;; MOVE [1.7] ; IF(M.LE.0)M=1
;; CAMLE DL ; IF(M.GT.M2)M=M2
;; AOJ 10, ; AC 10 HAS FILL INCREMENT
; SUBROUTINE FILLER(QQ,MD)
; COMMON /RINP/I(1) /ALF/NO,H(72) /PLTR/P,RHT,DIS
; DIMENSION Q(1)
; H(72) =NO MORE THAN 72 SEGS AT ANY SLICE POSITION!!!
;FILLER: 0 ; EQUIVALENCE (Q,I),(KNT,I(3))
MOVE RINP ; RL=Q(1)
MOVEM LEFT# ; FLOATING!
MOVEM RIGHT# ; RR=RL
SETZ 2, ; DO 1 K=1,KNT,3
FL1: MOVE RINP+2(2) ;CC Q(K)=IFIX(Q(K))
CAIN 3 ;CC Q(K+1)=IFIX(Q(K+1))
SETOM RINP+2(2) ;DO THIS ABOVE? IF(I(K+2).EQ.3)I(K+2)=-1
MOVE RINP(2) ; A=Q(K)
CAMN RINP+3(2) ; IF(Q(K+3).EQ.A)I(K+5)=-1
SETOM RINP+5(2) ;C VERTICAL LINES WILL BE IGNORED.
CAMGE LEFT ; IF(RL.GT.A)RL=A
MOVEM LEFT
CAMLE RIGHT ;1 IF(RR.LT.A)RR=A
MOVEM RIGHT ;C GET LEFT AND RIGHT EXTREME LIMITS.
ADDI 2,3 ;K=K+3
CAMGE 2,RINP+2 ;I(3)
JRST FL1
MOVN [0.5] ; RR=RR-.5
;; FADRM RIGHT
FADRM LEFT ; RL=RL-.5
FL2: MOVSI 202600 ;2 RL=RL+3
FADRB LEFT ;C SLICE COUNTER
CAML RIGHT ; IF(RL.GT.RR)RETURN
JRST FM6 ;JRA 16,2(16)
SETZ 11, ; M=0
MOVEI 2,3 ; DO 3 J=4,KNT,3
FL3: SKIPGE RINP+2(2) ; IF(I(J+2))GO TO 3
JRST FLX3
MOVE RINP(2) ;A IF(IHORZ(I,J,RL))GO TO 3
MOVE 1,RINP-3(2) ;B C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
CAML 0,1 ; FUNCTION IHORZ(Q,J,RL)
EXCH 0,1 ; DIMENSION Q(1)
CAML 0,LEFT ; IHORZ=-1
JRST FLX3 ; A=Q(J)
CAMG 1,LEFT ; B=Q(J-3)
JRST FLX3 ;PREVIOUS X COORD. IF(A.GT.B)CALL EXCH(A,B)
AOJ 11, ; IF(RL.LE.B.AND.RL.GE.A)IHORZ=0
; M=M+1
; H(M)=HGT(J,RL,I)
MOVE 3,RINP+1(2) ; FUNCTION HGT(J,RL,Q)
FSBR 3,RINP-2(2) ; DIMENSION Q(1)
MOVE LEFT ; HGT=Q(J-2)
FSBR RINP-3(2) ;C PREVIOUS Y COORD.
FMPR 3,0 ; A=Q(J-3)
MOVE RINP(2) ;C PREVIOUS X COORD.
FSBR RINP-3(2) ; HGT=((Q(J+1)-HGT)*(RL-A))/(Q(J)-A)+HGT
FDVR 3,0 ;CAN HAVE A DIVIDE BY ZERO HERE!!
FADR 3,RINP-2(2) ;3 CONTINUE
MOVEM 3,ALF(11) ;H(M)
FLX3: ADDI 2,3
CAMGE 2,RINP+2
JRST FL3
JUMPE 11,FL2 ; IF(M.EQ.0)GO TO 2
;C M=0=SPACE BETWEEN OBJECTS -- NO FILLER
MOVEI 2,1 ; J=1
FL5: MOVE ALF(2) ;5 IF(H(J).GE.H(J+1))GO TO 4
CAML ALF+1(2) ;C SORTS HEIGHTS
JRST FL4 ; CALL EXCH(H(J),H(J+1))
EXCH 0,ALF+1(2)
MOVEM ALF(2)
CAIN 2,1 ; IF(J.EQ.1)GO TO 4
JRST FL4
SOJ 2, ; J=J-1
JRST FL5 ; GO TO 5
FL4: AOJ 2, ;4 J=J+1
CAMGE 2,11 ; IF(J.LT.M)GO TO 5
JRST FL5 ;C GO BACK IF MORE SORTING TO BE DONE
MOVEI 14,1 ; NN=1
FL6: MOVE 13,ALF(14) ;CCCCC6 IF(H(NN).EQ.H(NN+1))GO TO 7
MOVE 12,ALF+1(14) ; A=H(NN)
MOVE 13 ; B=H(NN+1)
FSBR 12
CAMG [2.0] ; IF(A-B.GT.1)CALL LINX(RL,A-1.,RL,B+1.)
JRST FL7
FSBR 13,[1.0]
FADR 12,[1.0] ;A IS 13, B IS 12
JSA 16,LINES
JUMP LEFT
JUMP 13
JUMP [3]
JSA 16,LINES
JUMP LEFT
JUMP 12
JUMP [2]
FL7: ADDI 14,2 ;7 NN=NN+2
CAMGE 14,11 ;C SKIP BY 2'S
JRST FL6 ; IF(NN.LT.M)GO TO 6
JRST FL2 ; GO TO 2
FM6: MOVE DX ;2 CALL FILLER(NX,M)
MOVEM PLTR+2 ; DIS=DX
MOVE RX ; RHT=RX
MOVEM PLTR+1
DIST4: SKIPGE R9
JRA 16,6(16) ;5 RETURN
MOVE B ;C NEXT TO RESET DISTORTION FACT.
MOVEM DST ; BB=B
MOVE C ; CC=C
MOVEM DST+1
JRA 16,6(16) ; RETURN
END
BEND
BEGIN LINXG
TITLE LINXG
ENTRY LINES,PLOTS
EXTERNAL DST,PLTR,DPY,.COMM.,ROFF,XRN,SQRT,PLOT,.COMM.
KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
; SUBROUTINE LINES(A,B,L)
; COMMON/DST/BB,CC
; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
; 1,(JJ2,JJ(2))
; DATA BB/.008/,CC/3.5/
;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
M←2 ↔ NZ←3 ↔ K←4
DEFINE R9< .COMM.+=10>
LINES: 0 ; GO TO 23
DIST1: SKIPL R9
JRST L23 ;22 IF(JQ(1).NE.0)GO TO 23
SKIPE PLTR+=27
JRST L23 ; IF(CC.EQ.1000)GO TO 23
DIST: MOVSI T,212764
CAMN T,DST+1 ;** FOR DISTORATION -- SEE ALSO FILLMS ***
JRST L23 ; B=B*(CC-BB*ABS(A))
MOVM T,@(16)
FMPR T,DST ;BB IS DST, CC IS DST+1
FSBR T,DST+1
FMPRM T,@1(16)
MOVNS @1(16) ;23 IF(IPLT)GO TO 2
L23: SKIPGE PLTR
;; JRST L2
JRST L9
MOVE T,.COMM.+1 ;IF(JA.EQ.44)RETURN
CAIN T,=44 ;WON'T LOOK AT BARLINES FOR HEIGHT.
JRA 16,3(16)
MOVE T,@1(16)
CAMG T,DPY+1
JRST L333
MOVEM T,DPY+1 ; IF(B.LT.BOT)BOT=B
JRA 16,3(16)
L333: CAMG T,DPY+2
MOVEM T,DPY+2
JRA 16,3(16) ; IF(B.GT.TOP)TOP=B
;2 IF(IPLT.EQ.-2)RETURN
;;L2: MOVNI T,2
;; CAMN T,PLTR
;; JRA 16,3(16) ;9 M=ROFF(A*DIS)
L9: MOVE M,@(16)
FMPR M,PLTR+2
SKIPGE M
FADR M,[-=1.0]
FADR M,[=0.5]
KIFIX M,M
MOVEM M,MM# ; N=ROFF(B*RHT)
MOVE NZ,@1(16)
FMPR NZ,PLTR+1
SKIPGE NZ
FADR NZ,[-=1.0]
FADR NZ,[=0.5]
KIFIX NZ,NZ
MOVEM NZ,NN# ;8 CALL PLOT(M,N,L)
L8: MOVE T,@2(16)
MOVEM T,LL#
JSA 16,PLOT
JUMP MM
JUMP NN
JUMP LL ; END
JRA 16,3(16)
PLOTS: 0
JRA 16,1(16) ; DUMMY ROUTINE
J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ NQ←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
Y←13↔ X←14↔ L←15↔ M←1
JPOS: 0 ;C BLACKS IN NOTES
IPOS: 0 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
IC: 0
KZ: 0
END
BEND